home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / epistat.arc / LNREGRES.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1983-08-18  |  5.9 KB  |  114 lines
  1. 1  REM                      LINEAR REGRESSION
  2. 2  REM             Written by Tracy L. Gustafson, M.D.
  3. 3  REM            Round Rock, Texas. Version 2.0, 1983
  4. 5  DEF SEG=&H40
  5. 6  A=PEEK(&H17): IF NOT(A AND &H20) THEN POKE &H17,(A AND (NOT &H20)) OR &H20
  6. 7  DEF SEG: SCREEN 0,0,0: WIDTH 80: COLOR 7,0,1
  7. 8  CLEAR: OPTION BASE 1: KEY OFF: DEFINT A-C,N,T,Z: DEFSTR D
  8. 10  CLS: PRINT TAB(21);"KEY";STRING$(28,205);"CLOSE"
  9. 12  PRINT TAB(21);"OPEN LINEAR REGRESSION ANALYSIS OPEN"
  10. 15  PRINT TAB(21);"SCREEN";STRING$(28,205);"LOAD"
  11. 20  PRINT TAB(7);: INPUT "What is the name of the DATAFILE you wish to analyze?   ",FILE$: ON ERROR GOTO 765
  12. 30  OPEN FILE$ FOR INPUT AS #1: INPUT #1,A,C
  13. 32  PRINT: INPUT "Are you planning on performing any DATA TRANSFORMATIONS with this data?  ",ATRN$
  14. 34  IF ATRN$="N" OR ATRN$="n" THEN 35 ELSE IF ATRN$="y" OR ATRN$="Y" THEN INPUT " How many of these DATA TRANSFORMATIONS will you SAVE in this datafile?  ",NTRN ELSE BEEP: GOTO 32
  15. 35  AN=NTRN+A: IF AN>28 THEN BEEP: PRINT TAB(10);"This database will only hold another";28-A;"samples.": GOTO 34
  16. 40  DIM D(AN,C),CS(AN,C),ST(A,C),XT(A),XT2(A),N$(AN),X(AN),X2(AN),SD(AN),MD(AN),T(AN),B(A)
  17. 45  FOR T=1 TO A: INPUT #1, T(T): NEXT
  18. 50  FOR T=1 TO A: FOR Z=1 TO C: INPUT #1, D(T,Z): NEXT: NEXT
  19. 60  FOR T=1 TO A: FOR Z=1 TO T(T): INPUT #1, CS(T,Z): NEXT: NEXT
  20. 70  FOR T=1 TO A: INPUT #1, N$(T),X(T),X2(T),MD(T),SD(T): NEXT: CLOSE #1
  21. 80  PRINT :PRINT "    What are the SAMPLE NUMBERS of the 2 groups you want to compare?": PRINT TAB(8);"Independent sample:";TAB(45);"Dependent sample:"
  22. 90  PRINT TAB(10);: INPUT;"",NS1: IF NS1<=A THEN PRINT "  `";N$(NS1);"'"; ELSE BEEP: PRINT TAB(21);FILE$;" has only";A;"samples.": GOTO 90
  23. 95  PRINT TAB(50);: INPUT;"",NS2: IF NS2<=A THEN PRINT "  `";N$(NS2);"'": ELSE BEEP: PRINT TAB(21);FILE$;" has only";A;"samples.": GOTO 95
  24. 100  IF T(NS1)<>T(NS2) THEN PRINT: BEEP: PRINT "These 2 samples do not have the same number of elements----":PRINT TAB(37);"a regression analysis cannot be performed.":GOTO 80
  25. 105  XC=0: N=T(NS1): A1=0: A2=0
  26. 110  IF ATRN$<>"y" AND ATRN$<>"Y" THEN 350 ELSE PRINT: INPUT "Do you want DATA TRANSFORMATIONS prior to regression analysis? (Y or N)  ",A$
  27. 120  IF A$="n" OR A$="N" THEN 350 ELSE IF A$="y" OR A$="Y" THEN 130 ELSE BEEP: GOTO 110
  28. 130  CLS: PRINT TAB(15); "Choose the appropriate data TRANSFORMATIONS:":PRINT
  29. 150  PRINT TAB(20);"1.)  X' = x (no transformation)"
  30. 160  PRINT TAB(20);"2.)  X' = x<UNK! {FD22}>
  31. 170  PRINT TAB(20);"3.)  X' = <UNK! {00FB}>x"
  32. 175  PRINT TAB(20);"4.)  X' = 1/x"
  33. 180  PRINT TAB(20);"5.)  X' = x - mean"
  34. 190  PRINT TAB(20);"6.)  X' = ln(x)"
  35. 195  PRINT TAB(20);"7.)  X' = ln(x/(100-x))":PRINT:PRINT
  36. 200  PRINT "Transformation for independent variable `";N$(NS1);:INPUT "':  ",A1
  37. 210  IF ABS(A1-4)>3.1 THEN BEEP: GOTO 200
  38. 220  PRINT "  Transformation for dependent variable `";N$(NS2);:INPUT "':  ",A2
  39. 230  IF ABS(A2-4)>3.1 THEN BEEP: GOTO 220
  40. 240  TN=A1: NS=NS1: GOSUB 250
  41. 245  TN=A2: NS=NS2: GOSUB 250
  42. 248  FOR Z=1 TO N: XC=XC+ST(NS1,Z)*ST(NS2,Z): NEXT: GOTO 360
  43. 250  IF B(NS)=TN THEN 330
  44. 260  ON TN GOTO 270,280,290,292,295,300,310
  45. 270  FOR Z=1 TO N: ST(NS,Z)=VAL(D(NS,Z)): NEXT: GOTO 315
  46. 280  FOR Z=1 TO N: ST(NS,Z)=VAL(D(NS,Z))*VAL(D(NS,Z)): NEXT: GOTO 315
  47. 290  FOR Z=1 TO N: ST(NS,Z)=SQR(VAL(D(NS,Z))): NEXT: GOTO 315
  48. 292  FOR Z=1 TO N: ST(NS,Z)=1/VAL(D(NS,Z)): NEXT: GOTO 315
  49. 295  LM=X(NS)/T(NS): FOR Z=1 TO N: ST(NS,Z)=VAL(D(NS,Z))-LM: NEXT: GOTO 315
  50. 300  FOR Z=1 TO N: ST(NS,Z)=LOG(VAL(D(NS,Z))): NEXT: GOTO 315
  51. 310  FOR Z=1 TO N: L=VAL(D(NS,Z)): ST(NS,Z)=LOG(L/(100-L)): NEXT
  52. 315  XT(NS)=0: XT2(NS)=0
  53. 320  FOR Z=1 TO N: XT(NS)=XT(NS)+ST(NS,Z): XT2(NS)=XT2(NS)+ST(NS,Z)*ST(NS,Z):    NEXT
  54. 330  B(NS)=TN: RETURN
  55. 350  FOR Z=1 TO N: XC=XC+VAL(D(NS1,Z))*VAL(D(NS2,Z)): NEXT
  56. 355  XT(NS1)=X(NS1): XT2(NS1)=X2(NS1): XT(NS2)=X(NS2): XT2(NS2)=X2(NS2)
  57. 360  SC=XC-XT(NS1)*XT(NS2)/N
  58. 370  SX=(XT2(NS1)-XT(NS1)*XT(NS1)/N): SY=(XT2(NS2)-XT(NS2)*XT(NS2)/N)
  59. 380  SB=SC/SX: IA=(XT(NS2)-SB*XT(NS1))/N
  60. 390  PRINT: COLOR 0,7: PRINT TAB(13);"Regression equation:  Y =";IA;: IF SB>0 THEN PRINT "+"; ELSE PRINT "-";
  61. 395  PRINT ABS(SB);"* X";TAB(79): COLOR 7,0: PRINT: PRINT
  62. 400  ADF=N-2: S2=(SY-SC*SC/SX)/ADF: SEB=SQR(S2/SX): ST=ABS(SB)/SEB
  63. 410  PRINT "Significance of slope:    T =";ST;TAB(45);"df =";ADF;
  64. 420  R=ATN(ST/SQR(ADF)): RC=COS(R): R2=RC*RC: RS=SIN(R): X=1
  65. 430  IF ADF MOD 2=0 THEN 510
  66. 440  IF ADF=1 THEN Y=R: GOTO 500
  67. 450  Y=RC
  68. 460  FOR Z=3 TO (ADF-2) STEP 2: X=X*R2*(Z-1)/Z: Y=Y+X*RC: NEXT
  69. 470  Y=R+RS*Y
  70. 500  P=1-Y*0.63662: GOTO 560
  71. 510  Y=1
  72. 520  FOR Z=2 TO (ADF-2) STEP 2: X=X*R2*(Z-1)/Z: Y=Y+X: NEXT
  73. 530  P=1-Y*RS
  74. 560  PLAY "MB O3 T240 L8 G L16 F#GF#GF#GF#GF# L12 G L10 F#EF# L2 G"
  75. 570  PRINT TAB(60);"p = ";: IF P<9.99E-07 THEN PRINT "< 10 (-6)" ELSE PRINT P
  76. 580  PRINT: COLOR 0,7: PRINT TAB(10);"The slope of this line is ";
  77. 590  IF P>0.05 THEN PRINT "NOT ";
  78. 600  PRINT "significantly different than 0";TAB(79): COLOR 7,0: PRINT
  79. 610  PRINT "Confidence limits on the slope can be calculated as:": PRINT :
  80. 615  ADF$=STR$(ADF): ADF$=RIGHT$(ADF$,LEN(ADF$)-1)
  81. 620  PRINT TAB(20);SB;"+/- T(";ADF$;") *";SEB: PRINT
  82. 630  IF A1>1 THEN PRINT "  Do you want to save the TRANSFORMED data `";N$(NS1);"' as sample #";A+1;: INPUT "?  ",A$: NS=NS1: SN=SX: A3=A1: GOSUB 660
  83. 640  IF A2>1 THEN PRINT "  Do you want to save the TRANSFORMED data `";N$(NS2);"' as sample #";A+1;: INPUT "?  ",A$: NS=NS2: SN=SY: A3=A2: GOSUB 660
  84. 650  GOTO 720
  85. 660  IF A$="Y" OR A$="y" THEN AF=1: A=A+1 ELSE 710
  86. 670  PRINT TAB(7);"Enter name for the TRANSFORMED `";N$(NS);:INPUT "' data sample:  ",N$(A)
  87. 675  FOR Z=1 TO N: SP=INT(ST(NS,Z)*1E+07)*9.8E-08: DS=STR$(SP)
  88. 680  IF SP>0 THEN D(A,Z)=RIGHT$(DS,LEN(DS)-1) ELSE D(A,Z)=DS
  89. 685  NEXT: IF A3=4 THEN 695
  90. 690  FOR Z=1 TO N: CS(A,Z)=CS(NS,Z): NEXT: GOTO 700
  91. 695  FOR Z=1 TO N: CS(A,Z)=CS(NS,(N-Z+1)): NEXT
  92. 700  T(A)=N: X(A)=XT(NS): X2(A)=XT2(NS): SD(A)=SQR(SN/(N-1))
  93. 705  IF N MOD 2=0 THEN MD(A)=(VAL(D(A,CS(A,N/2)))+VAL(D(A,CS(A,N/2+1))))*0.5 ELSE MD(A)=VAL(D(A,CS(A,N/2+0.5)))
  94. 710  RETURN
  95. 720  INPUT "Do you want to perform another REGRESSION using this data file? (Y or N)  ",A$
  96. 725  IF A$="y" OR A$="Y" THEN CLS: GOTO 80 ELSE IF A$="N" OR A$="n" THEN 730 ELSE BEEP: GOTO 720
  97. 730  ON ERROR GOTO 780
  98. 735  IF AF=1 THEN OPEN FILE$ FOR OUTPUT AS #1 ELSE GOTO 760
  99. 740  WRITE #1, A,C: FOR T=1 TO A: WRITE #1, T(T): NEXT
  100. 745  FOR T=1 TO A: FOR Z=1 TO C: WRITE #1, D(T,Z): NEXT: NEXT
  101. 750  FOR T=1 TO A: FOR Z=1 TO T(T): WRITE #1, CS(T,Z): NEXT: NEXT
  102. 755  FOR T=1 TO A: WRITE #1, N$(T),X(T),X2(T),MD(T),SD(T): NEXT: CLOSE #1
  103. 760  END
  104. 765  BEEP: PRINT: IF ERL=30 AND ERR=53 THEN PRINT: PRINT TAB(13); "I cannot find a file by that name on drive "; ELSE 810
  105. 770  IF MID$(FILE$,2,1)=":" THEN DR$=LEFT$(FILE$,2) ELSE DR$="A:"
  106. 775  PRINT DR$: PRINT "Your files are:": FILES DR$+"*.*": RESUME 20
  107. 780  BEEP: PRINT: IF ERL<>735 THEN 810
  108. 785  IF ERR=61 OR ERR=67 THEN PRINT "That disk is full.  Change disks and try again."
  109. 790  IF ERR=64 OR ERR=52 THEN PRINT "That is not a valid FILE NAME.  Please change name."
  110. 795  IF ERR=70 THEN PRINT "That disk is write-protected.  Put your data on a different disk."
  111. 800  IF ERR=71 THEN PRINT "That disk is not ready.  Check drive and try again."
  112. 805  RESUME
  113. 810  ON ERROR GOTO 0
  114.